COMMENT ⊗   VALID 00012 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00003 00002	begin "TEXPRE" comment TEX preprocessing routines
C00005 00003	The following code is copied from TEXSYS
C00026 00004	Default values for math decoding
C00031 00005	Initializing the hash table and equivalents: identer,inithash
C00063 00006	Initializing the exception table
C00072 00007	Initializing the suffix table
C00079 00008	Initializing the prefix table
C00085 00009	Initializing the consonant-pair table
C00087 00010	Initializing the delimiter table
C00089 00011	Initializing the font memory
C00092 00012	The driver program
C00096 ENDMK
C⊗;
begin "TEXPRE" comment TEX preprocessing routines;

comment This program builds the tables that define TEX's built-in control
sequences and that contain TEX's built-in knowledge about hyphenation.
The relevant sections of TEXSYN and TEXSEM explain the format of these tables.

TEXPRE has been written as a separate module since it is unnecessary to have
all this lengthy initialization code present when running TEX, and since the
SAIL system has no mechanism for overlaying unneeded program segments.

The next page of code is simply copied from TEXSYS, then comes
new stuff and a new driver program instead of the TEXSYS main program;

require "TEXHDR.SAI" source_file;
require "TEXSYN.REL" load_module;
require "TEXSEM.REL" load_module;
require ifc DVIOUT thenc "TEXDVI.REL" elsec "TEXPRS.REL" endc load_module;
require "TEXEXT.REL" load_module;
comment The following code is copied from TEXSYS;

comment Error handling procedures: quit,error,backerror,overflow,confusion;

label end_of_texpre;
internal procedure quit # closes output files and terminates TEX;
begin DEBUGONLY bail # when debugging, here's a last chance to see the memory;
go to end_of_texpre;
end;

internal boolean pausing_on_errors # should TEX wait after error messages?;
internal boolean not_nonstop # should TEX wait for other reasons?;
internal boolean deletions_allowed # is it safe for error routine to call getnext?;

internal procedure error(string s) # prints an error message;
begin comment String s explains the type of error. This is displayed to the
user and then the current source code position is indicated;
print(nextline,"! ",s,".");
dumpcontext # prints indication of where the scanner is now;
if pausing_on_errors then
  loop	begin integer c;
	print("↑"); c←inchrw;
	ifc TENEX thenc
	if c='37 then return # Tenex end-of-line character;
	elsec
	if c='15 then begin c←inchrw # ignore the line-feed; return end;
	endc
	if c='12 then begin pausing_on_errors←false; return end;
	ifc not TENEX thenc
	if c="T" or c="t" then edfile(curfile,curfline,curfpage);
	endc
	if c="X" or c="x" then quit;
	print(nextline,"Type <cr> to continue, <lf> to flash error messages,
	", ifc not TENEX thenc "t or T to edit, ", endc "x or X to quit.");
	end;
end;

internal procedure backerror(string s) # error followed by backinput;
begin error(s);
backinput;
end;

internal procedure errorstop(string s) # prints message and dies;
begin pausing_on_errors←false;
error(s);
quit;
end;

internal procedure reportoverflow(string s; integer n)
	# for fatal errors when a TEX table is undersized;
begin pausing_on_errors←false;
error("TEX capacity exceeded, sorry ["&s&"="&cvs(n)&"]");
quit;
end;

internaldef overflow(s)=⊂reportoverflow("s",s)⊃ # specifies inadequate table size;
internal procedure memoverflow; overflow(memsize);

internal procedure confusion # TEX consistency check failure;
begin pausing_on_errors←false;
error("This can't happen");
DEBUGONLY bail;
quit;
end;
internal procedure mustquit; confusion;

comment Dynamic memory allocation: links, memsize, varsize, mem, memreal;

comment TEX does nearly all of its own memory allocation, so that it can
readily be transported into environments that do not have automatic
facilities for strings, garbage collection, etc. The dynamic storage
requirements of TEX are handled by providing a large integer array "mem" 
in which consecutive blocks of words are used as nodes by the TEX routines.
Pointer variables are indices into this array. To use mem[p] as a real
variable instead of as an integer, we write "memreal(p)".

The mem array is divided once and for all into two regions that are allocated
separately. The first varsize locations are used for storing variable-length
records consisting of two or more words. This region is maintained using an
algorithm similar to the one described in exercise 2.5-19 of ACP. However,
no size field appears in the allocated nodes: the program is responsible for
knowing the relevant size when the node is freed. Also, the sign in the first
word of each node is used as a boundary tag by the allocation routines, so
ALL DATA STRUCTURES MUST BE DESIGNED TO ENSURE THAT THE FIRST WORD OF
TWO-OR-MORE-WORD NODES IS NONNEGATIVE. The remaining region of mem is allocated
in single words using a conventional AVAIL stack.
;
internaldef links = 14 # number of bits per pointer;
internaldef memsize=8000 # size of dynamic list memory, must be ≤ 2↑links;
internaldef varsize=2500 # size of variable node memory, must be << memsize;

comment saf integer array mem[0:memsize-1] # dynamic list memory;
internaldef memreal(p)=⊂memory[location(mem[p]),real]⊃ # mem[p] as type real;

MSTAT internal integer dynused,varused # how much memory is in use;
MSTAT internal integer maxdynused,maxvarused # how much memory was in use;

comment Partial field macros: field,ufield,link,info,setfield...setinfo;

comment The following macros are for accessing and modifying partial fields
of packed words. If f is a field name, then fs denotes its size in bits
and fd denotes its displacement from the right of the word. These sizes and
displacements are defined at compile time--e.g.,"links" for size of link fields.
In the following definitions, x denotes the word being modified and y denotes
a new value to be inserted into the specified field (it must not be too
large for the field). The definitions look inefficient, but they take
advantage of the fact that SAIL does a lot of local optimization;


internaldef fs(f) = ⊂f⊃&"s" # field size of f, in bits;
internaldef fd(f) = ⊂f⊃&"d" # field displacement of f, in bits;

internaldef field(f,x) = ⊂ifc fd(f)=0 thenc ((x) land (2↑fs(f)-1))
	elsec ifc fs(f)+fd(f)≥bitsperwd thenc ((x) lsh -fd(f))
	elsec (((x) lsh -fd(f)) land (2↑fs(f)-1)) endc endc⊃ # field f of x;

internaldef setfield(f,x,y) = ⊂ifc fd(f)=0 thenc x←(x land(-2↑fs(f)))+(y)
	elsec ifc fs(f)+fd(f)≥bitsperwd thenc 
		x←((x lsh(bitsperwd-fd(f)))+(y))rot fd(f)
	elsec x←(((x rot -fd(f))land(-2↑fs(f)))+(y))rot fd(f) endc endc⊃
		# sets field f of x equal to y, 0 ≤ y < 2↑fs(f);

comment Sometimes an unshifted field is desired. For this purpose, we use
ufield instead of field, and deal with values times 2↑fd;

internaldef ufield(f,x) = ⊂((x) land((1 lsh(fs(f)+fd(f)))-2↑fd(f)))⊃
		# unshifted field f of x;
internaldef setufield(f,x,y) = ⊂x←(x land lnot((1 lsh(fs(f)+fd(f)))-2↑fd(f)))+(y)⊃
		# field f of x set to unshifted value y;

comment The special case of a pointer field at the right of a word is
most common, so there are special conventions for it. When p is a pointer,
we write link(p) for the pointer field of mem[p] and info(p) for the
(shifted) remaining fields of the word;

internaldef linkd = 0 # displacement of link field;
internaldef link(p) = ⊂field(link,mem[p])⊃ # link field of mem[p];
internaldef setlink(p,y) = ⊂setfield(link,mem[p],y)⊃ # sets link(p)←y;
internaldef infod = links, infos = bitsperwd-infod # definition of info field;
internaldef info(p) = ⊂field(info,mem[p])⊃ # info field of mem[p];
internaldef setinfo(p,y) = ⊂setfield(info,mem[p],y)⊃ # sets info(p)←y;

DEBUGONLY integer procedure lk(integer x);
DEBUGONLY return(x land(2↑links-1)) # link field of packed word;
DEBUGONLY integer procedure fo(integer x);
DEBUGONLY return(x lsh -infod) # info field of packed word;

comment Memory allocation procedures: getavail, freeavail, getnode, freenode;

comment	getavail(p) makes p point to a new one-word node,
	freeavail(p) returns it to storage.
	p←getnode(s) makes p point to a new s-word node and clears mem[p] to zero,
	freenode(p,s) will return this node to storage.
;
internaldef getavail(p) = ⊂begin if(p←avail)then avail←mem[avail]
	else memoverflow: MSTAT dynused←dynused+1:
	MSTAT if dynused>maxdynused then maxdynused←dynused end⊃ # p ← new node;
internaldef freeavail(p) = ⊂begin mem[p]←avail: avail←p:
	MSTAT dynused←dynused-1: end⊃ # node p now available;

comment The available space list for variable-size nodes is a nonempty,
doubly-linked circular list, pointed to by the roving pointer "rover". 
The second word of each entry contains the size (which is always ≥2), while
the first word contains the llink and rlink and a minus sign;

integer rover # pointer into double-avail list;
define nodesize(p) = ⊂mem[p+1]⊃;
define llinks = links, llinkd = infod # definition of llink field;

internal integer procedure getnode(integer size) # variable-size node allocation;
begin comment returns a pointer to a new node of the specified size,
which must be 2 or more. All words of the new node are set to zero;
integer p,q,s,t,u;
label ovfl, found;
comment The following tricky code does
	llink(rlink(p))←llink(p), rlink(llink(p))←rlink(p);
define removenode(p)=
	⊂begin if p=rover then
		begin rover←link(p);
		if p=rover then go to ovfl # list musn't become empty;
		end;
	u←((p lsh llinkd) + p) xor mem[p] # bits to change;
	t←field(llink,mem[p]) # llink(p);
	mem[t]←field(link,u) xor mem[t];
	t←link(p) # rlink(p);
	mem[t]←ufield(llink,u) xor mem[t];
	end⊃;
p←rover;
do	begin q←p+nodesize(p) # q points past the end of node(p);
	while mem[q]<0 do
		begin comment merge with the next node, if it is free too;
		removenode(q); q←q+nodesize(q);
		end;
	if (s←q-p) ≥ size+2 then
		begin q←q-size # allocate from top end;
		nodesize(p)←q-p # remaining free area size;
		rover ← p # let rover rove around;
		go to found;
		end;
	if s = size then
		begin removenode(p) # exact fit, now t = rlink(p);
		rover ← t # let rover rove;
		q ← p; go to found;
		end;
	nodesize(p)←s # reset the node size in case it grew;
	p←link(p);
	end until p=rover # repeat until whole list traversed;
ovfl: overflow(varsize) # no large enough space was found;
found: for p ← q thru q+size-1 do mem[p]←0 # clear out the node found;
MSTAT varused←varused+size;
MSTAT if varused>maxvarused then maxvarused←varused;
return(q) # deliver the goods;
end;

DEBUGONLY internal procedure checkmem(boolean printlocs) # checks links in mem;;

internal procedure freenode(integer p,size) # variable-size node liberation;
begin comment The node of length "size" starting at mem[p] is made available
to the variable-node storage pool, by inserting it into the double-avail
list just before where rover now points. We must have size ≥ 2;
integer q;
q←field(llink,mem[rover]) # llink(rover);
setlink(q,p); setfield(llink,mem[rover],p);
mem[p]←(q lsh llinkd)+rover+(1 lsh(bitsperwd-1)) # now p is linked into the circle;
MSTAT varused←varused-size;
nodesize(p)←size;
end;

comment Memory, continued: dslist,delrclink,delgluelink,showmem,initmem;

internal procedure dslist(integer p) # makes list of 1-word nodes available;
begin comment The linked list of single-word nodes pointed to by p is freed;
integer q;
while p do
	begin q←link(p); freeavail(p); p←q;
	end;
end;

internaldef refct1 = 1 lsh infod # 1 in the information (reference count) field;

internal simp procedure delrclink(integer p) # remove ptr to list with ref ct;
begin comment info(p) is a reference count that is to be decreased by 1.
If the result is negative, the linked list of single-word nodes pointed to by p
is freed;
if(mem[p]←mem[p]-refct1)<0 then dslist(p);
end;

internal simp procedure delgluelink(integer p) # remove pointer to glue node;
begin comment info(p) is a reference count that is to be decreased by 1.
If the result is negative, node(p) (which has "gluespecsize" words) is freed;
if(mem[p]←mem[p]-refct1)<0 then freenode(p,gluespecsize);
comment In this case it's OK to let the first word of the node go negative;
end;

procedure showmem # checks and displays the free areas of mem when debugging;
begin comment This procedure prints a map of the free locations and checks
the format of the available space lists. All nodes should be returned to
the avail lists when TEX is done with them, and showmem can be used to
check if this has been done correctly;
boolean array free[0:memsize-1];
integer p,i; label printout;
p←avail;
while p do
	begin if free[p] or mem[p]≥memsize or (mem[p]≠0 and mem[p]≤varsize) then
		begin print(nextline,"avail list clobbered at ",p); done;
		end;
	free[p]←true;
	p←mem[p];
	end;
p←rover;
do	begin
	if p≥varsize or p≤0 or mem[p]≥0 or p+nodesize(p)>varsize or
	nodesize(p)<2 or field(llink,mem[link(p)])≠p then
		begin print(nextline,"double-avail list clobbered at ",p); done;
		end;
	for i←p thru p+nodesize(p)-1 do
		begin if free[i] then
			begin print(nextline,"doubly free location at ",i);
			go to printout;
			end;
		free[i]←true;
		end;
	p←link(p);
	end until p=rover;
printout: for i←0 thru memsize-1 do
	begin if i mod 64 = 0 then print(nextline);
	if free[i] then print("X") else print(".");
	end;
end;

comment Some areas of mem are dedicated to fixed usage. For example, the
list heads "pagehead" and "pagecontrib" of the page builder are assigned
to fixed memory locations. (Since mem[pagecontrib] will never be
negative, we define pagecontrib=varsize, then the getfree procedure will
never try to combine the one-word memory with a variable-size free node.)
The special glue used in \hfill and \vfill is kept in a fixed place, as
are the heads of alignrecord lists. Only locations mem[firstmem] thru
mem[varsize-1] are actually allocatable for variable-size memory, 
and mem[secondmem] thru mem[memsize-1] for one-word memory.
;

internal procedure initmem # initializes the memory system;
begin integer i;
for i←secondmem thru memsize-1 do mem[i+1]←i;
mem[secondmem]←0 # now the avail stack is initialized;

mem[firstmem]←(firstmem lsh llinkd)+firstmem+(1 lsh(bitsperwd-1));
nodesize(firstmem)←varsize-firstmem # one node in the circle;
rover←firstmem # rover points to it, now the double-avail list is initialized;

for i←0 thru firstmem-1 do mem[i]←0;
for i←varsize thru secondmem-1 do mem[i]←0;
end;
comment Default values for math decoding;

define bin(x)=⊂x+(binnoad lsh 9)⊃, op(x)=⊂x+(opnoad lsh 9)⊃,
	rel(x)=⊂x+(relnoad lsh 9)⊃, opn(x)=⊂x+(opennoad lsh 9)⊃,
	cls(x)=⊂x+(closenoad lsh 9)⊃, punct(x)=⊂x+(punctnoad lsh 9)⊃;
preload_with bin('401),rel('443),'213,'214,bin('536),'472,'217,'231,
		comment null(center-dot),down,alpha,beta,meet,not,epsilon,pi;
	'225,'215,'216,ifc not MIT thenc op('563) elsec rel('442) endc,
			bin('406),bin('410),'461,'245,
		comment lambda,gamma,delta,ifc not MIT thenc integral elsec up endc,
			plsmns,circplus,infinity,partl;
	rel('432),rel('433),bin('534),bin('533),'470,'471,bin('412),rel('444),
		comment cont_in,contains,cap,cup,for_all,exists,circtms,dblarrow;
	ifc not MIT thenc '465 elsec rel('440) endc,rel('441),
			ifc not MIT thenc rel('430) elsec rel('434) endc,
			ifc not MIT thenc rel('434) elsec bin('405) endc,
			rel('424),rel('425),rel('421),bin('537),
		comment ifc not MIT thenc underline elsec left endc,right,
			ifc not MIT thenc tilde elsec uneq endc,
			ifc not MIT thenc uneq elsec diamond endc,
			lseq,gteq,equiv,join;
	'463,cls('41),'541,'561,'577,'45,'46,cls('47),
		comment space,exc,dblquotes,sharp,dollar,percent,ampersand,apost;
	opn('50),cls('51),'52,bin('53),punct('54),bin('400),'56,'57,
		comment left_paren,right_paren,astrsk,plus,comma,minus,period,slash;
	'60,'61,'62,'63,'64,'65,'66,'67,
		comment 0,1,2,3,4,5,6,7;
	'70,'71,'72,punct('73),rel('74),rel('75),rel('76),cls('77),
		comment 8,9,colon,semicolon,less,equal,greater,query;
	'574,'301,'302,'303,'304,'305,'306,'307,
		comment at,A,B,C,D,E,F,G;
	'310,'311,'312,'313,'314,'315,'316,'317,
		comment H,I,J,K,L,M,N,O;
	'320,'321,'322,'323,'324,'325,'326,'327,
		comment P,Q,R,S,T,U,V,W;
	'330,'331,'332,opn('133),bin('404),cls('135),
			ifc not MIT thenc rel('442) elsec rel('442) endc,
			ifc not MIT thenc rel('440) elsec '465 endc,
		comment X,Y,Z,left_bracket,backslash,right_bracket,
			ifc not MIT thenc up elsec up endc,
			ifc not MIT thenc left elsec underscore endc;
	opn('140),'341,'342,'343,'344,'345,'346,'347,
		comment rev_apostrophe,a,b,c,d,e,f,g;
	'350,'351,'352,'353,'354,'355,'356,'357,
		comment h,i,j,k,l,m,n,o;
	'360,'361,'362,'363,'364,'365,'366,'367,
		comment p,q,r,s,t,u,v,w;
	'370,'371,'372,opn('546),'552,
			ifc SUAI thenc bin('405) elsec cls('547) endc,
			ifc SUAI thenc cls('547) elsec rel('430) endc,
			ifc not MIT thenc bin('017) elsec op('563) endc;
		comment x,y,z,left_brace,absolute,
			ifc SUAI thenc diamond elsec rightbrace endc,
			ifc SUAI thenc rightbrace elsec tilde endc,
			ifc not MIT thenc hat elsec integral endc;
saf integer array mathdecode[0:'177] # decoding table for characters in math mode;
comment Initializing the hash table and equivalents: identer,inithash;

procedure identer(string s; integer cmd,lnk);
begin comment This procedure forms the packed name corresponding to string s
and creates a hash table entry having idlev=1 and the specified cmd and
link. It is used only during the initialization of TEX, to store the reserved
control sequences into the hash table. Since the procedure changes global
variable curbuf, it must be used only before the "initin" procedure is called.
Since the procedure also indirectly accesses the savestack, it must be used
only after the "initsave" procedure is called;
inbuf←curbuf←s; controlseq # pretend s was in the input;
eqtb[hashentry]←level1+(cmd lsh idcmdd)+lnk;
end;

procedure inithash # initialize hash and eqtb;
begin comment All predeclared control sequences are entered into the table here;
integer i;
for i←0 thru 127 do chartype(i)←otherchar;
for i←"A" thru "Z" do chartype(i)←letter;
for i←"a" thru "z" do chartype(i)←letter;
for i←'00,'12, IFSUAI '13,'175, ENDSUAI '177 do chartype(i)←ignore
		# null,linefeed, IFSUAI vtab,alt, ENDSUAI delete;
for i←'11,'40 do chartype(i)←spacer # tab and blankspace;
for i←'14,'15 do chartype(i)←carret # formfeed and carriagereturn;

for i← 0 thru 127 do mmodecode(i)←mathdecode[i];
for i←0 thru hprime-1 do hhead[i]←hashsize;
for i←locs+1 thru hashsize do hash[i]←i-1; hash[locs]←-1;

comment Now we enter control sequences in approximately the reverse order
of their frequency of use (since most recent are fastest to access);

comment The following codes refer to TEX's special non-ascii fonts;
identer("join",mathonly,op('727)) # large logical and (lattice join) sign;
identer("meet",mathonly,op('726)) # large logical or (lattice meet) sign;
identer("munion",mathonly,op('725)) # large multiset union sign (U with +);
identer("inter",mathonly,op('724)) # large set intersection sign;
identer("union",mathonly,op('723)) # large set union sign;
identer("int",mathonly,op('722)) # large integral sign;
identer("prod",mathonly,op('721)) # large Pi sign for product;
identer("sum",mathonly,op('720)) # large Sigma sign for summation;
identer("oprod",mathonly,op('716)) # large circle-times sign;
identer("osum",mathonly,op('714)) # large circle-plus sign;
identer("odotprod",mathonly,op('712)) # large circle-dot sign;
identer("oint",mathonly,op('710)) # large contour integral sign;
identer("squnion",mathonly,op('706)) # large square union sign;
identer("$",mathonly,'577) # dollar sign;
identer("sterling",mathonly,'576) # British pound sign;
identer("copyright",mathonly,'575) # c in circle;
identer("@",mathonly,'574) # at sign;
identer("P",mathonly,'573) # paragraph symbol;
identer("ddag",mathonly,'572) # double dagger;
identer("dag",mathonly,'571) # dagger;
identer("section",mathonly,'570) # section symbol;
identer("diam",mathonly,bin('567)) # small diamond operator;
identer("sqsub",mathonly,rel('566)) # square inclusion sign in Scott semantics;
identer("glb",mathonly,bin('565)) # square intersection sign in Scott semantics;
identer("lub",mathonly,bin('564)) # square union sign in Scott semantics;
identer("smallint",mathonly,op('563)) # small integral sign;
identer("nabla",mathonly,'562) # inverted u.c. delta;
identer("#",mathonly,'561) # sharp sign (hash mark or American pound);
identer("surd",mathonly,'560) # radical (square root) sign;
identer("dright",mathonly,cls('555)) # double right bracket;
identer("dleft",mathonly,opn('554)) # double left bracket;
identer("relvv",mathonly,rel('553)) # || treated as relation (disjointness);
identer("rightvv",mathonly,cls('553)) # || treated as right bracket;
identer("leftvv",mathonly,opn('553)) # || treated as left bracket;
identer("|",mathonly,'553) # ||;
identer("relv",mathonly,rel('552)) # | treated as relation (divides, or set def'n);
identer("rightv",mathonly,cls('552)) # | treated as right bracket;
identer("leftv",mathonly,opn('552)) # | treated as left bracket;
identer("rangle",mathonly,cls('551)) # right angle bracket;
identer("langle",mathonly,opn('550)) # left angle bracket;
ifc not SUAI thenc identer('175&null,mathonly,cls('547)) # Ascii right brace; endc
ifc SUAI or PARC thenc
	identer('176&null,mathonly,cls('547)) # Stanford's right brace; endc
identer("{",mathonly,opn('546)) # left brace;
identer("rceil",mathonly,cls('545)) # right ceiling bracket;
identer("lceil",mathonly,opn('544)) # left ceiling bracket;
identer("rfloor",mathonly,cls('543)) # right floor bracket;
identer("lfloor",mathonly,opn('542)) # left floor bracket;
identer("dashv",mathonly,cls('541)) # -| (right turnstile);
identer("vdash",mathonly,opn('540)) # |- (left turnstile);
identer("uplus",mathonly,bin('535)) # multiset union +∪;
identer("Zscr",mathonly,'532) # u.c. script Z;
identer("Yscr",mathonly,'531) # u.c. script Y;
identer("Xscr",mathonly,'530) # u.c. script X;
identer("Wscr",mathonly,'527) # u.c. script W;
identer("Vscr",mathonly,'526) # u.c. script V;
identer("Uscr",mathonly,'525) # u.c. script U;
identer("Tscr",mathonly,'524) # u.c. script T;
identer("Sscr",mathonly,'523) # u.c. script S;
identer("Rscr",mathonly,'522) # u.c. script R;
identer("Qscr",mathonly,'521) # u.c. script Q;
identer("Pscr",mathonly,'520) # u.c. script P;
identer("Oscr",mathonly,'517) # u.c. script O;
identer("Nscr",mathonly,'516) # u.c. script N;
identer("Mscr",mathonly,'515) # u.c. script M;
identer("Lscr",mathonly,'514) # u.c. script L;
identer("Kscr",mathonly,'513) # u.c. script K;
identer("Jscr",mathonly,'512) # u.c. script J;
identer("Iscr",mathonly,'511) # u.c. script I;
identer("Hscr",mathonly,'510) # u.c. script H;
identer("Gscr",mathonly,'507) # u.c. script G;
identer("Fscr",mathonly,'506) # u.c. script F;
identer("Escr",mathonly,'505) # u.c. script E;
identer("Dscr",mathonly,'504) # u.c. script D;
identer("Cscr",mathonly,'503) # u.c. script C;
identer("Bscr",mathonly,'502) # u.c. script B;
identer("Ascr",mathonly,'501) # u.c. script A;
identer("not",mathonly,rel('500)) # zero-width character negates a relation symbol;
identer("top",mathonly,'476) # Scott top (upside down perpendicular);
identer("imag",mathonly,'475) # u.c. Fraktur I;
identer("real",mathonly,'474) # u.c. Fraktur R;
identer("aleph",mathonly,'473) # u.c. aleph;
identer("angle",mathonly,'466) # /_;
identer("emptyset",mathonly,'464) # /0;
identer("notin",mathonly,rel('463)) # /ε;
identer("in",mathonly,rel('462)) # ε meaning set element;
identer("infty",mathonly,'461) # infinity;
identer("prime",mathonly,'460) # prime (intended to appear in script size only);
identer("mapsto",mathonly,rel('457)) # |→;
identer("rsh",mathonly,bin('456)) # right shift symbol;
identer("lsh",mathonly,bin('455)) # left shift symbol;
identer("↔",mathonly,rel('454)) # <=>;
identer("↓",mathonly,rel('453)) # ∨||;
identer(ifc MIT thenc '13 elsec "↑" endc,mathonly,rel('452)) # ∧||;
identer("→",mathonly,rel('451)) # =>;
identer(ifc MIT thenc '30 elsec "←" endc,mathonly,rel('450)) # <=;
identer("simeq",mathonly,rel('447)) # ~-;
identer("grgr",mathonly,rel('446)) # >>;
identer("lsls",mathonly,rel('445)) # <<;
identer("down",mathonly,rel('443)) # ↓;
identer("up",mathonly,rel('442)) # ↑;
identer("succ",mathonly,rel('437)) # succeeds (curly version of >);
identer("prec",mathonly,rel('436)) # precedes (curly version of <);
identer("doteq",mathonly,rel('435)) # dot over equals;
identer("approx",mathonly,rel('431)) # approximate equality;
identer("succeq",mathonly,rel('427)) # succeeds or equals;
identer("preceq",mathonly,rel('426)) # precedes or equals;
identer("supset",mathonly,rel('423)) # ⊃_;
identer("subset",mathonly,rel('422)) # ⊂_;
identer("bot",mathonly,'420) # Scott bottom (_|_);
identer("perp",mathonly,rel('420)) # perpendicular (_|_);
identer("bullet",mathonly,bin('417)) # filled-in circle operator;
identer("interc",mathonly,bin('416)) # intercalation product;
identer("div",mathonly,bin('415)) # elementary division (-:-);
identer("odot",mathonly,bin('414)) # circle dot;
identer("odiv",mathonly,bin('413)) # circle divide;
identer("otimes",mathonly,bin('412)) # circle times (⊗);
identer("ominus",mathonly,bin('411)) # circle minus;
identer("oplus",mathonly,bin('410)) # circle plus;
identer("mp",mathonly,bin('407)) # minus-or-plus;
identer("pm",mathonly,bin('406)) # plus-or-minus;
identer("circ",mathonly,bin('405)) # small circle operator;
identer("rslash",mathonly,bin('404)) # reverse slash (\);
identer("ast",mathonly,bin('403)) # asterisk resting on baseline;
identer("times",mathonly,bin('402)) # cross product;
identer("cdot",mathonly,bin('401)) # centered dot;
identer("varpi",mathonly,'377) # variant l.c. pi (script style, one stroke);
identer("vartheta",mathonly,'376) # variant l.c. theta (not closed at left);
identer("varphi",mathonly,'375) # variant l.c. phi (not pointed at top);
identer("omega",mathonly,'374) # l.c. omega;
identer("psi",mathonly,'373) # l.c. psi;
identer("jit",mathonly,'300) # dotless italic j;
identer("partial",mathonly,'245) # partial derivative sign;
identer("wp",mathonly,'244) # Weierstrass p;
identer("lscr",mathonly,'243) # l.c. script ell;
identer("iit",mathonly,'240) # dotless italic i;
identer("chi",mathonly,'237) # l.c. chi;
identer("phi",mathonly,'236) # l.c. phi;
identer("upsilon",mathonly,'235) # l.c. upsilon;
identer("tau",mathonly,'234) # l.c. tau;
identer("sigma",mathonly,'233) # l.c. sigma;
identer("rho",mathonly,'232) # l.c. rho;
identer("pi",mathonly,'231) # l.c. pi;
identer("xi",mathonly,'230) # l.c. xi;
identer("nu",mathonly,'227) # l.c. nu;
identer("mu",mathonly,'226) # l.c. mu;
identer("lambda",mathonly,'225) # l.c. lambda;
identer("kappa",mathonly,'224) # l.c. kappa;
identer("iota",mathonly,'223) # l.c. iota;
identer("theta",mathonly,'222) # l.c. theta;
identer("eta",mathonly,'221) # l.c. eta;
identer("zeta",mathonly,'220) # l.c. zeta;
identer("epsilon",mathonly,'217) # l.c. epsilon;
identer("delta",mathonly,'216) # l.c. delta;
identer("gamma",mathonly,'215) # l.c. gamma;
identer("beta",mathonly,'214) # l.c. beta;
identer("alpha",mathonly,'213) # l.c. alpha;
identer("Omegait",mathonly,'212) # u.c. italic omega;
identer("Psiit",mathonly,'211) # u.c. italic psi;
identer("Phiit",mathonly,'210) # u.c. italic phi;
identer("Upsilonit",mathonly,'207) # u.c. italic upsilon;
identer("Sigmait",mathonly,'206) # u.c. italic sigma;
identer("Piit",mathonly,'205) # u.c. italic pi;
identer("Xiit",mathonly,'204) # u.c. italic xi;
identer("Lambdait",mathonly,'203) # u.c. italic lambda;
identer("Thetait",mathonly,'202) # u.c. italic theta;
identer("Deltait",mathonly,'201) # u.c. italic delta;
identer("Gammait",mathonly,'200) # u.c. italic gamma;

identer("O",nonmathletter,'100) # O with slash (Scandinavian);
identer("o",nonmathletter,'40) # o with slash (Scandinavian);
identer("OE",nonmathletter,'37) # French ligature OE;
identer("AE",nonmathletter,'36) # Latin or Scandinavian ligature AE;
identer("oe",nonmathletter,'35) # French ligature oe;
identer("ae",nonmathletter,'34) # Latin or Scandinavian ligature ae;
identer("ss",nonmathletter,'33) # German ligature ss;
identer("t",accent,'32) # tie for Russian ligatures;
identer("l",accent,'31) # cross for lower case l (Polish);
identer("c",accent,'30) # cedilla (French, Polish, Navajo, etc.);
identer("a",accent,'27) # small circle accent (Scandinavian);
identer("H",accent,'26) # long Hungarian umlaut;
identer("b",accent,'25) # vector accent;
identer("s",accent,'24) # tilde;
identer("""",accent,'23) # umlaut or dieresis;
identer("=",accent,'22) # macron (bar) accent;
identer("u",accent,'21) # breve;
identer("v",accent,'20) # inverted circumflex accent (Slavic);
identer("A",accent,'17) # circumflex (hat) accent;
identer("'",accent,'16) # acute accent;
identer("`",accent,'15) # grave accent;
identer("j",nonmathletter,'14) # dotless j;
identer("i",nonmathletter,'13) # dotless i;
identer("Omega",mathonly,'12) # u.c. omega;
identer("Psi",mathonly,'11) # u.c. psi;
identer("Phi",mathonly,'10) # u.c. phi;
identer("Upsilon",mathonly,'07) # u.c. upsilon;
identer("Sigma",mathonly,'06) # u.c. sigma;
identer("Pi",mathonly,'05) # u.c. pi;
identer("Xi",mathonly,'04) # u.c. xi;
identer("Lambda",mathonly,'03) # u.c. lambda;
identer("Theta",mathonly,'02) # u.c. theta;
identer("Delta",mathonly,'01) # u.c. delta;
identer("Gamma",mathonly,'00) # u.c. gamma;

identer("spacefactor",spcfctr,0);
identer("skip",skp,0);
identer("parshape",shape,0);
identer("let",altname,0);
identer("codeval",codeval,0);
identer("parval",codeval,271) # eqtb[271+128] is the location of the first parameter;
identer("ifdimen",ifdimen,0);
identer("send",send,0); hashsend←hashentry;
identer("open",send,1);
identer("unbox",unbox,0);
identer("font",deffont,0);
identer("unskip",unskip,0);
identer("hangindent",hangindent,0);
identer("vtop",vcenter,2);
identer("vcenter",vcenter,1);
identer("lowercase",caseshift,0);
identer("uppercase",caseshift,1);
identer("/",italcorr,0);
identer("scriptscriptstyle",mathstyle,scriptscriptstyle);
identer("scriptstyle",mathstyle,scriptstyle);
identer("textstyle",mathstyle,textstyle);
identer("dispstyle",mathstyle,dispstyle);
identer("quad",mathstyle,quadspace);
identer("?",mathstyle,negthickspace);
identer("!",mathstyle,negthinspace);
identer("<",mathstyle,negopspace);
identer("≤",mathstyle,negthspace);
identer(">",mathstyle,opspace);
identer("≥",mathstyle,thspace);
identer(";",mathstyle,thickspace);
identer(",",mathstyle,thinspace);
identer("comb",above,3);
identer("over",above,2);
identer("atop",above,1);
identer("above",above,0);
identer("limitswitch",limsw,0);
identer("underline",mathinput,undernoad);
identer("overline",mathinput,overnoad);
identer("sqrt",mathinput,sqrtnoad);
identer("mathpunct",mathinput,punctnoad);
identer("mathclose",mathinput,closenoad);
identer("mathopen",mathinput,opennoad);
identer("mathrel",mathinput,relnoad);
identer("mathbin",mathinput,binnoad);
identer("mathop",mathinput,opnoad);
identer("right",leftright,rightnoad);
identer("left",leftright,leftnoad);
identer('15&null,exspace,userspace) # \<cr> is like \<space>;
identer('14&null,exspace,userspace) # \<ff> is like \<space>;
identer('13&null,exspace,userspace) # \<vt> is like \<space>;
identer('12&null,exspace,userspace) # \<lf> is like \<space>;
identer('11&null,exspace,userspace) # \<tab> is like \<space>;
identer(" ",exspace,userspace);
identer("eqno",eqno,0);
identer("leqno",eqno,1);
identer("accent",newaccent,0);
identer("*",discr,'402);
identer("-",discr,"-");
identer("eject",eject,1);
identer("linebreak",eject,0);
identer("pagebreak",eject,2);
identer("noindent",noindent,0);
identer("penalty",penlty,0);
identer("dpenalty",penlty,1);
identer("mark",mark,0);
identer("firstmark",topbotmark,2);
identer("botmark",topbotmark,0);
identer("topmark",topbotmark,1);
identer("botinsert",topbotins,0);
identer("topinsert",topbotins,1);
identer("botsep",topbotins,2);
identer("topsep",topbotins,3);
identer("hrule",hrule,0);
identer("vrule",vrule,0);
identer("mskip",hskip,100);
identer("hskip",hskip,0);
identer("hss",hskip,4);
identer("hfilneg",hskip,3);
identer("hfil",hskip,2);
identer("hfill",hskip,1);
identer("vskip",vskip,0);
identer("vss",vskip,4);
identer("vfilneg",vskip,3);
identer("vfil",vskip,2);
identer("vfill",vskip,1);
identer("noalign",noalign,0);
identer("valign",valign,0);
identer("halign",halign,0);
identer("cleaders",leaders,":");
identer("leaders",leaders,";");
identer("xleaders",leaders,"<");
identer("save",save,0);
identer("lower",vmove,0);
identer("raise",vmove,1);
identer("moveright",hmove,0);
identer("moveleft",hmove,1);
identer("hbox",box,3+hmode);
identer("vbox",box,3+vmode);
identer("page",box,0);
identer("box",box,1);
identer("copy",box,2);
identer("thebox",box,3);
identer("else",elsecode,0);
identer("if",ifT,0);
identer("ifx",ifx,0);
identer("ifmmode",ifmode,mmode);
identer("ifhmode",ifmode,hmode);
identer("ifvmode",ifmode,vmode);
identer("ifpos",ifeven,1);
identer("ifeven",ifeven,0);
identer("count",count,0);
identer("advcount",advcount,0);
identer("setcount",setcount,0);
identer("mathex",fntfam,3);
identer("mathsy",fntfam,2);
identer("mathit",fntfam,1);
identer("mathrm",fntfam,0);
identer("chpar",chcode,271) # eqtb[271+128] is the location of the first parameter;
identer("chcode",chcode,0);
identer("char",ascii,0);
identer("ddt",ddt,0);
identer("end",stop,0);
identer("input",innput,0);
identer("output",output,0);
identer("xdef",def,2);
identer("gdef",def,1);
identer("def",def,0);
identer(":",font,0); eqtb[fontloc]←eqtb[hashsize+":"]+(1 lsh links)-1;

	comment default of each special glue is zero;
define zglueref=level1+(glueref lsh idcmdd)+zeroglue;
identer("tabskip",assignglue,tabskiploc); eqtb[tabskiploc]←zglueref;
identer("botskip",assignglue,botskiploc); eqtb[botskiploc]←zglueref;
identer("topskip",assignglue,topskiploc); eqtb[topskiploc]←zglueref;
identer("dispbskip",assignglue,dispbskiploc); eqtb[dispbskiploc]←zglueref;
identer("dispaskip",assignglue,dispaskiploc); eqtb[dispaskiploc]←zglueref;
identer("dispskip",assignglue,dispskiploc); eqtb[dispskiploc]←zglueref;
identer("parskip",assignglue,parskiploc); eqtb[parskiploc]←zglueref;
identer("baselineskip",assignglue,baselineskiploc); eqtb[baselineskiploc]←zglueref;
identer("lineskip",assignglue,lineskiploc); eqtb[lineskiploc]←zglueref;
identer("spaceskip",assignglue,spaceskiploc); eqtb[spaceskiploc]←zglueref;
identer("xspaceskip",assignglue,xspaceskiploc); eqtb[xspaceskiploc]←zglueref;
identer("parfillskip",assignglue,parfillskiploc); eqtb[parfillskiploc]←
	level1+(glueref lsh idcmdd)+filglue;
identer("specskip",assignglue,specskiploc);
	for i←0 thru 9 do eqtb[specskiploc+i]←zglueref;

	comment default lineskiplimit is zero;
identer("lineskiplimit",assignreal,lineskiplimitmem); pagemem[lineskiplimitmem]←0;
	comment default varunit is 1.0 point;
identer("varunit",assignreal,varunitmem); pagemem[varunitmem]←1.0;
	comment default mathsurround is zero;
identer("mathsurround",assignreal,mathsurrmem); pagemem[mathsurrmem]←0;
	comment default topbaseline is 10.0 points;
identer("topbaseline",assignreal,topbaselinemem); pagemem[topbaselinemem]←10.0;
	comment default parindent is zero;
identer("parindent",assignreal,parindentmem); pagemem[parindentmem]←0;
	comment default maxdepth is 3.0 points;
identer("maxdepth",assignreal,maxdepthmem); pagemem[maxdepthmem]←3.0;
	comment default vsize is about 7.0 inches;
identer("vsize",assignreal,vsizemem); pagemem[vsizemem]←7.0*72.0;
	comment default hsize is about 4.5 inches;
identer("hsize",assignreal,hsizemem); pagemem[hsizemem]←4.5*72.0;

identer("x",xt,0);
identer("par",parend,0); hashpar←hashentry;
identer("cr",carret,0);

comment Now set the standard parameter values in the upper part of eqtb;
mathfonttable(0)←mathfonttable(1)←mathfonttable(2)←mathfonttable(3)←-1;
tracing←'345 # trace control;
jpar←2 # justification feasibility on hyphenation pass;
hpen←50 # hyphenation penalty;
penpen←3000 # penultimate hyphenation penalty (squared);
wpen←80 # widow line penalty;
bpen←50 # page break after hyphenated line penalty;
mbpen←95 # penalty for line break after binary operator in math formula;
mrpen←50 # penalty for line break after relation in math formula;
ragged←0 # degree of raggedness;
disppen←500 # penalty for page break before display;
dumplength←500 # max length of strings for displayed token lists;
radsign←'560760 # position of radical signs in math fonts;
rfudge←1000 # printing magnification factor times 1000;
adjpen←3000 # adjacent-line penalty (squared);
loose←0 # paragraph looseness;
jjpar←2 # first-pass feasibility threshold;
uchyph←0 # hyphenates upper case automatically if nonzero;
exhyph←50 # penalty after hyphen or dash;
xpar1←xpar2←xpar3←0 # parameters for extensions;

begin comment Now the hash and eqtb arrays are initialized, report their fullness;
integer n;
print(nextline,"Hash table of size ",hashsize," preloaded with ",hashsize-1-havail,
	" control sequences.");
n←0;for i←0 thru 127 do if eqtb[hashsize+i] then n←n+1;
print(nextline,"Furthermore ",n," single-character control sequences are",
	" predefined.");
end;
end;
comment Initializing the exception table;

procedure xent(string s) # enter an exception s;
begin integer n,m,c,w,t,i,j,h; string ss;
ss←s; n←0; w←0; m←0;
while c←lop(s) do
	if c="-" then w←w lor 1 else
	if c="*" then m←m+1 else
	begin n←n+1; w←w lsh 1;
	mem[n] ← c land '37;
	end;
w←w rot(1-n);
j←7 min n;
while m do begin w←w+(mem[j+m]lsh(5*(m-1))); m←m-1 end;
t←mem[1];
for i←2 thru j do t←(t lsh 5)+mem[i];
h←t mod excepsize;
while t do
	begin while exceptable[h]>t do h←h-1;
	if h=0 then h←excepsize-1
	else if exceptable[h]=t then
		begin print(nextline,"Whoops: double entry ",ss);
		return;
		end
	else	begin j←exceptable[h]; c←excephyph[h];
		exceptable[h]←t; excephyph[h]←w;
		t←j; w←c;
		end;
	end;
end;

preload_with
"ap-pre-ciable",
"con-trol-lable","un-con-trollable",
"flam-mable","in-flam-mable","in-es-ti-mable",
"for-mi-dable","por-table","im-preg-nable",
"eq-uable","in-sa-tiable","ne-go-tiable","so-ciable","turn-table","un-so-ciable",
"con-stable","stable","un-stable","work-table",
"de-pen-dent","in-de-pen-dent",
"any-thing","dar-ling","dump-ling","eve-ning","every-thing",
"far-thing","found-ling","ink-ling","main-spring","off-spring",
"play-thing","sap-ling","shoe-string","sib-ling","some-thing","star-ling",
"ster-ling","un-err-ing","up-swing","weak-ling","year-ling",
"in-fringed",
"civ-i-lize","crys-tal-lize","im-mo-bi-lize","mo-bi-lize",
"mo-nop-o-lize","sta-bi-li*ze","tan-ta-lize","un-civ-i-lized","uti-lize",
"pal-ate",
"in-clem-ent",
"bar-on-ess","li-on-ess",
"eu-logy","ped-a-gogy",
"lus-cious",
"met-al","non-metal","pet-al","postal","rent-al",
"cat-ion",
"com-bat-ive",
"stat-ure",
"beck-on","beck-oned","bes-tial",
"come-back","co-me-dian","comp-troller",
"cone-flower","co-nun-drum",
"equipped",
"handle-bar",
"inch-worm","ink-blot","inn-keeper",
"in-te-rior",
"min-is-ter","min-is-try",
"none-the-less",
"qua-drille",
"som-er-sault",
"su-pe-rior",
"tran-spire",
"una-nim-ity","unan-i-mous","unc-tuous",
"debt-or",
"ac-knowl-edge",
"de-duct-i*ble",
"vict-ual",
"nee-dle-work","idler",
"off-beat","off-hand","off-print","off-set","off-set-ting","off-shoot","off-shore",
"stiff-en",
"left-ist","left-over","lift-off",
"soft-hearted",
"egg-nog","egg-head",
"cognac","de-sign-er","for-eign-er","poi-gnant","vignette",
"hogs-head",
"child-ish","gold-en","hold-out","hold-over","hold-up",
"self-ish","self-adjoint","un-self-ish",
"bull-ish","crest-fallen","dis-till-*ery","fall-out","lull-aby","roll-away",
"sell-out","small-est","tall-est","wall-eye",
"psalm-ist",
"adult-hood",
"else-where","false-hood",
"volt-age",
"re-volv-er",
"beach-comb-er","bomb-er","climb-er","plumb-er",
"damp-en",
"hence-forth","mince-meat",
"bind-ery","bound-ary",
"fiend-ish","land-owner","out-land-ish","round-about","send-off","stand-out",
"change-over","hang-out","hang-over","orange-ade",
"ant-acid","ant-eater","count-ess","rep-re-sentative",
"ant-hill","pent-house","per-cent-*age",
"adapt-er","crypt-analysis",
"in-ter-ru*p*t-*i*ble",
"an-tiq-uity","in-eq-uity","in-iq-uity","liq-uefy","liq-uid",
"liq-ui-date","pre-req-ui-site","req-ui-sition",
"ubiq-ui-tous",
"herbal",
"arch-angel","re-search-ers",
"board-er","chordal","hard-en","hard-est","haz-ard-ous",
"re-cord-er","stan-dard-ize","stew-ard-ess","yard-age",
"non-con-form-ist",
"cav-ern-ous","dis-cern-ible","mod-ern-ize","turn-about","turn-over",
"west-ern-ize",
"harp-ist","sharp-en",
"ir-re-ver*s-ible","nurse-maid","re-hears-al",
"re-vers-i*ble","wors-en",
"art-ist","as-sert-i*ve","con-vert-ible","court-yard","fore-short-en","heart-ache",
"heart-ily","short-en",
"apart-heid","court-house","earth-en-ware","north-east","north-ern","port-hole",
"ob-serv-er","serv-er",
"pre-school",
"con-de-scend","cre-scen*do","de-cre-scendo","de-scen-dent","de-scent",
"om-ni-scient","pleb-i-scite","re-scind","sea-scape",
"askance","snake-skin","whisk-er",
"cole-slaw",
"rattle-snake",
"class-room","cross-over","dis-miss-al","ex-press-*i*ble",
"less-en","toss-up","un-class-i-fied",
"ar-mi-stice","astig-ma-tism","astir","blast-off","by-stand-er",
"candle-stick","cast-away","cast-off","co-star",
"di-gest-i*ble","east-ern","fore-stall",
"in-di-ges*t-*i*ble","in-ex-haust-ible","ir-re-sist-ible",
"life-style","lime-stone","live-stock","mile-stone",
"pho-to-stat","re-start-ed","re-state-ment","re-store","shy-ster",
"side-step","smoke-stack","sug-gest-*i*ble","thermo-stat","waste-bas-ket",
"waste-land",
"mast-head","post-hu-mous","priest-hood",
"side-swipe",
"watt-meter",
"be-tween",
"kib-itzer",
"buzz-er",
"al-go-rithm","bib-li-ography","bi-no-mial","cat-e-go-ry",
"cen-ter","com-put-a*bil-ity",
"dec-la-ra-tion","de-gree","de-vel-op-ment",
"es-tab-lish","hap-hazard","neg-li-gible","pe-ri-odic",
"poly-no-mial","pre-vious","pro-ce-dure","prob-abil-ity",
"prob-lem-atic","pro-gram-ming","pub-li-ca-tion","pub-lish","ref-er-ence",
"re-place-ment","sub-sequ*e*n*ce","when-ever",
""; string array exceptions[0:excepsize-1];

procedure initex;
begin integer i; string s;
arrclr(exceptable); arrclr(excephyph);
i←0;
while s←exceptions[i] do
	begin xent(s); i←i+1;
	end;
print(nextline,"Exception table contains ",i," entries in ordered hash table",
	" of size ",excepsize,".");
end;
comment Initializing the suffix table;

procedure initsuf;
begin
define opcodes=9,opcoded=27,truexs=9,truexd=18,falsexs=9,falsexd=9,oprands=9,
	oprandd=0 # fields in interpreted instructions;
define scan=0,double=1,table=2,check=3,success=4,fail=5,repeat=6,again=7,
	mark=8,efail=9 # numeric equivalents of symbolic opcodes;

define s(n,a,b,c,d)=⊂suffix[n]←(a lsh opcoded)+(b lsh oprandd)+
	(c lsh truexd)+(d lsh falsexd)⊃;
define t(c)=⊂(flag lsh -("c" land '37))⊃;

suffix[0]←flag+t(a)+t(e)+t(i)+t(o)+t(u)+t(y);
s(1,fail,0,0,0)	# a;
s(2,fail,0,0,0) # b;
s(3,scan,"i",34,1) # c;
s(4,again,0,1,0) # d;
s(5,mark,0,38,0) # e;
s(6,fail,0,0,0) # f;
s(7,scan,"n",60,1) # g;
s(8,fail,0,0,0) # h;
s(9,fail,0,0,0) # i;
s(10,fail,0,0,0) # j;
s(11,fail,0,0,0) # k;
s(12,scan,"a",71,72) # l;
s(13,fail,0,0,0) # m;
s(14,scan,"o",77,1) # n;
s(15,fail,0,0,0) # o;
s(16,fail,0,0,0) # p;
s(17,fail,0,0,0) # q;
s(18,scan,"e",81,1) # r;
s(19,mark,0,85,0) # s;
s(20,scan,"n",94,1) # t;
s(21,fail,0,0,0) # u;
s(22,fail,0,0,0) # v;
s(23,fail,0,0,0) # w;
s(24,fail,0,0,0) # x;
s(25,scan,"l",109,98) # y;
s(26,efail,0,0,0) # z;
s(27,success,0,0,0);
s(28,success,1,0,0);
s(29,success,2,0,0);
s(30,success,3,0,0);
s(31,repeat,0,0,0);
s(32,repeat,1,0,0);
s(33,repeat,2,0,0);
s(34,scan,"p",35,26) # e/ic;
s(35,scan,"o",36,26) # pe/pic;
s(36,scan,"c",37,26) # ope/opic;
s(37,scan,"s",27,26) # cope/copic;
s(38,scan,"l",39,40) # e;
s(39,scan,"b",41,26) # le;
s(40,scan,"t",42,43) # e;
s(41,scan,"a",44,26) # ble;
s(42,scan,"a",45,26) # te;
s(43,scan,"z",46,47) # e;
s(44,scan,"t",48,49) # able/ably;
s(45,table,50,108,26) # ate;
s(46,scan,"i",51,26) # ze;
s(47,scan,"v",52,53) # e;
s(48,table,54,26,32) # table;
s(49,table,107,26,31) # able;
suffix[50]←t(c)+t(l);
s(51,scan,"l",32,26) # ize;
s(52,scan,"i",55,26) # ve;
s(53,scan,"r",56,34) # e;
suffix[54]←t(e)+t(i)+t(o)+t(u)+t(t);
s(55,scan,"t",27,26) # ive/ure;
s(56,scan,"u",55,57) # re;
s(57,scan,"e",58,26) # re;
s(58,scan,"h",59,26) # ere;
s(59,scan,"p",37,26) # here;
s(60,scan,"i",61,1) # ng;
s(61,check,3,62,110) # ing;
s(62,scan,"l",63,64) # ing;
s(63,table,65,27,66) # ling;
s(64,table,67,28,68) # ing;
suffix[65]←t(b)+t(c)+t(d)+t(f)+t(g)+t(p)+t(t)+t(z);
s(66,scan,"k",69,28) # ling;
suffix[67]←t(f)+t(s)+t(z);
s(68,table,0,28,70) # ing;
s(69,scan,"c",29,27) # kling;
s(70,double,0,27,27) # ing;
s(71,scan,"i",73,74) # al;
s(72,scan,"u",75,1) # l;
s(73,scan,"t",27,76) # al/ial;
s(74,scan,"n",14,73) # al;
s(75,scan,"f",31,1) # ul;
s(76,scan,"c",27,1) # al/ial/ient;
s(77,scan,"i",78,1) # on/onal;
s(78,table,79,80,1) # ion/ional;
suffix[79]←t(s)+t(t);
s(80,mark,4,27,0) # sion/sional/tion/tional;
s(81,scan,"h",82,1) # er/y;
s(82,scan,"p",83,1) # her/hy;
s(83,scan,"a",84,1) # pher/phy;
s(84,scan,"r",27,1) # apher/aphy;
s(85,scan,"u",86,87) # s;
s(86,scan,"o",88,4) # us;
s(87,scan,"s",89,4) # s;
s(88,scan,"i",90,4) # ous;
s(89,scan,"e",91,4) # ss;
s(90,scan,"c",92,4) # ious;
s(91,table,93,31,4) # ess;
s(92,scan,"s",27,27) # cious;
suffix[93]←t(l)+t(n);
s(94,scan,"e",95,1) # nt;
s(95,scan,"m",31,96) # ent;
s(96,scan,"d",27,97) # ent;
s(97,scan,"i",76,1) # ent;
s(98,scan,"g",99,100) # y;
s(99,scan,"o",27,1) # gy;
s(100,scan,"r",101,81) # y;
s(101,scan,"a",102,1) # ry;
s(102,scan,"n",103,1) # ary;
s(103,scan,"o",104,27) # nary;
s(104,scan,"i",106,28) # onary;
suffix[105]←t(b)+t(c)+t(d)+t(f)+t(g)+t(h)+t(j)+t(k)+t(l)+t(m)+t(n)+t(p)+t(q)+
	    t(r)+t(s)+t(t)+t(v)+t(w)+t(x)+t(z);
s(106,repeat,3,0,0) # ionary;
suffix[107]←t(c)+t(f)+t(g)+t(p)+t(r);
s(108,table,0,28,26) # cate/late;
s(109,scan,"b",115,31) # ly;
s(110,check,1,111,1) # ing;
s(111,table,105,112,27) # ing;
s(112,table,105,113,28) # <cons>ing;
s(113,check,0,114,1) # <cons><cons>ing;
s(114,table,105,1,29) # <cons><cons>ing;
s(115,scan,"a",44,32) # bly;
end;
comment Initializing the prefix table;

procedure initpref;
begin
define opcodes=9,opcoded=27,truexs=9,truexd=18,falsexs=9,falsexd=9,oprands=9,
	oprandd=0 # fields in interpreted instructions;
define scan(n,c,t,f)=⊂prefix[n]←"c"+(t lsh truexd)+(f lsh falsexd)⊃;
define repeat(n,t)=⊂prefix[n]←(6 lsh opcoded)+t⊃;
define mark(n,t)=⊂prefix[n]←(8 lsh opcoded)+t⊃;
define table(n)=⊂prefix[n]←(2 lsh opcoded)⊃;
define fayl(n)=⊂prefix[n]←5 lsh opcoded⊃;
define vow(n)=⊂prefix[n]←4 lsh opcoded⊃;
define cons(n)=⊂prefix[n]←7 lsh opcoded⊃;
define t(c)=⊂(flag lsh -(("c" land '37)+opcodes))⊃;
define vs=1,cs=6,ts=7 # locations where there is a "vow","cons","table0" inst;

fayl(0) # in case mem[u+1] gets set to zero by the suffix routine;
vow(1) # a;
scan(2,e,34,cs) # b;
scan(3,o,36,cs) # c;
scan(4,i,38,cs) # d;
scan(5,q,41,44) # e;
cons(6) # f;
table(7) # g;
scan(8,a,45,47) # h;
scan(9,m,27,55) # i;
cons(10) # j;
cons(11) # k;
scan(12,e,61,cs) # l;
scan(13,a,63,70) # m;
scan(14,o,76,cs) # n;
scan(15,u,77,78) # o;
scan(16,s,81,cs) # p;
scan(17,u,85,cs) # q;
cons(18) # r;
scan(19,e,87,89) # s;
scan(20,h,97,99) # t;
scan(21,n,106,vs) # u;
cons(22) # v;
cons(23) # w;
cons(24) # x;
vow(25) # y;
cons(26) # z;
repeat(27,0);
repeat(28,1);
repeat(29,2);
mark(30,0);
mark(31,1);
mark(32,2);
mark(33,3);
table(34)+t(c)+t(f)+t(h)+t(s)+t(w) # be;
scan(35,i,vs,27) # un;
scan(36,m,30,37) # co;
scan(37,n,30,vs) # co;
scan(38,s,39,vs) # di;
scan(39,h,ts,40) # dis;
scan(40,y,vs,27) # dis;
scan(41,u,42,cs) # eq;
scan(42,i,43,cs) # equ;
scan(43,v,30,30) # equi;
scan(44,x,30,vs) # e;
scan(45,n,46,vs) # ha;
scan(46,d,30,ts) # han;
scan(47,o,48,51) # h;
scan(48,r,49,vs) # ho;
scan(49,s,50,ts) # hor;
scan(50,e,30,ts) # hors;
scan(51,y,52,cs) # h;
scan(52,p,53,vs) # hy;
scan(53,e,54,ts) # hyp;
scan(54,r,33,vs) # hype;
scan(55,n,56,vs) # i;
scan(56,t,57,27) # in;
scan(57,e,58,59) # int;
scan(58,r,33,29) # inte;
scan(59,r,60,28) # int;
scan(60,o,33,29) # intr;
scan(61,x,62,vs) # le;
scan(62,i,31,ts) # lex/max/min;
scan(63,c,64,66) # ma;
scan(64,r,65,ts) # mac;
scan(65,o,32,ts) # macr;
scan(66,t,67,69) # ma;
scan(67,h,68,ts) # mat;
scan(68,e,31,ts) # math;
scan(69,x,62,vs) # ma;
scan(70,i,71,72) # m;
scan(71,n,62,vs) # mi;
scan(72,u,73,cs) # m;
scan(73,l,74,vs) # mu;
scan(74,t,75,ts) # mul;
scan(75,i,32,ts) # mult;
scan(76,n,27,vs) # no;
scan(77,t,30,vs) # ou;
scan(78,v,79,vs) # o;
scan(79,e,80,ts) # ov;
scan(80,r,27,vs) # ove;
scan(81,e,82,cs) # ps;
scan(82,u,83,vs) # pse;
scan(83,d,84,vs) # pseu;
scan(84,o,32,ts) # pseud;
scan(85,a,86,cs) # qu;
scan(86,d,30,vs) # qua;
scan(87,m,88,vs) # se;
scan(88,i,30,ts) # sem;
scan(89,o,90,92) # s;
scan(90,m,91,vs) # so;
scan(91,e,30,ts) # som/ther;
scan(92,u,93,cs) # s;
scan(93,b,30,94) # su;
scan(94,p,95,vs) # su;
scan(95,e,96,ts) # sup;
scan(96,r,33,vs) # supe;
scan(97,e,98,cs) # th;
scan(98,r,91,vs) # the;
scan(99,r,100,cs) # t;
scan(100,a,101,104) # tr;
scan(101,n,102,vs) # tra;
scan(102,s,103,ts) # tran;
table(103)+t(a)+t(f)+t(g)+t(l)+t(m)+t(p)+t(s)+t(v) # trans;
scan(104,i,105,cs) # tr;
table(105)+t(a)+t(f)+t(u) # tri;
scan(106,d,107,35) # un;
scan(107,e,108,28) # und;
scan(108,r,33,29) # unde;
end;
comment Initializing the consonant-pair table;

procedure initb # sets btable;
begin
define hchars=3,hchard=0,weaks=3,weakd=3 # definition of btable fields;
define t(c)=⊂(flag lsh -(("c" land '37)-1))⊃;
define weak(n)=⊂(n lsh weakd) lor btable[26+n]⊃;
define b(n)=⊂btable[n]←0⊃;

b(26) # weak(0) and z;
b(27)+t(t) # weak(1), for f and s;
b(28)+t(d) # weak(2), for l;
b(29)+t(p) # weak(3), for m;
b(30)+t(d)+t(g)+t(s)+t(t) # weak(4), for n;
b(31)+t(g)+t(m)+t(n)+t(t) # weak(5), for r;

b(2)+t(l)+t(r) # b;
b(3)+t(l)+t(r)+4 # c;
b(4)+t(g)+t(r) # d;
b(5)+t(l)+t(r) # ch;
b(6)+t(l)+t(r)+weak(1) # f;
b(7)+t(l)+t(r)+4 # g;
b(8) # h;
b(9)+t(t) # gh;
b(10) # j;
b(11)+t(n) # k;
b(12)+t(k)+t(q)+weak(2) # l;
b(13)+weak(3) # m;
b(14)+t(e)+t(k)+t(x)+weak(4) # n;
b(15)+t(r) # ph;
b(16)+t(l)+t(r)+1 # p;
b(17) # q;
b(18)+t(k)+weak(5) # r;
b(19)+t(p)+t(q)+weak(1)+4 # s;
b(20)+t(e)+t(r)+7 # t;
b(21) # sh;
b(22) # v;
b(23)+t(h)+t(l)+t(n)+t(r) # w;
b(24) # x;
b(25)+t(r) # th;
end;
comment Initializing the delimiter table;

procedure initd # sets delimtable;
begin arrclr(delimtable,-1);
comment Each nondelimiter gets the value -1,
while each delimiter gets the 18-bit delimiter code used by math routines;
delimtable["."] ← 0;
delimtable["("] ← '050600;
delimtable[")"] ← '051601;
delimtable["["] ← '133602;
delimtable["]"] ← '135603;
delimtable["<"] ← '550612;
delimtable[">"] ← '551613;
delimtable["|"] ← '552614;
delimtable["/"] ← '057616;
delimtable["{"] ← '546610;
ifc SUAI or PARC thenc
delimtable['176&null] ← '547611 # Stanford right brace;
endc
ifc not SUAI thenc
delimtable['175&null] ← '547611 # Ascii right brace;
endc
end;
comment Initializing the font memory;

procedure initfnt # sets fmem, wdbase, ..., parbase;
begin integer i,f,unbal;
for f←0 thru nfonts-1 do parbase[f]←0;
fmemptr←0;
MSTAT dynused←varused←maxdynused←maxvarused←0;
initin;initsave;initout;
print(nextline,nextline,"Now type < \input <filename> >* \end to preload fonts:");
unbal←0;
loop	begin getnext;
	case curcmd of begin comment mini-texsem;
	[stop] if unbal=0 then done;
	[innput] if unbal=0 then begin inputfile; lvl←curlev end;
	[chcode] if unbal=0 then begin integer j; j←curchar;
	j←scannumber+j # j now identifies the parameter or character code location;
	getnctok # this token is ignored, it might be space or = or ←, etc.;
	chcodedef(j,scannumber) end;
	[lbrace] unbal←unbal+1;
	[rbrace] unbal←unbal-1;
	[deffont] if unbal=0 and curbuf≠"{" then f←scanfont(false);
	else comment do nothing;
	  end;
	end;
comment now restore the effects of \chcodes;
for i←0 thru 127 do chartype(i)←otherchar;
for i←"A" thru "Z" do chartype(i)←letter;
for i←"a" thru "z" do chartype(i)←letter;
for i←'00,'12, IFSUAI '13,'175, ENDSUAI '177 do chartype(i)←ignore
		# null,linefeed, IFSUAI vtab,alt, ENDSUAI delete;
for i←'11,'40 do chartype(i)←spacer # tab and blankspace;
for i←'14,'15 do chartype(i)←carret # formfeed and carriagereturn;
end;
comment The driver program;

integer chan;

string errname, tblname;

ifc MIT thenc
	errname ← "ERRORS TMP"; tblname ← "TEX;TEXINI TBL";
elsec ifc TENEX thenc
	errname ← "ERRORS.TMP;T"; tblname ← "TEXINI.TBL";
elsec
	errname ← "ERRORS.TMP"; tblname ← "TEXINI.TBL";
endc

setprint(errname,"B");
DEBUGONLY bail;

not_nonstop←true;
initmem;
initin;initsave;inithash;
initex;initsuf;initpref;initb;
initd;initfnt;
DEBUGONLY bail;

open(chan←getchan,"DSK",'10,0,2,0,0,eof);
enter(chan,tblname,eof);
wordout(chan,secondmem);
wordout(chan,memsize);
wordout(chan,hashsize);
wordout(chan,hprime);
wordout(chan,eqtbsize);
wordout(chan,excepsize);
wordout(chan,sufsize);
wordout(chan,prefsize);
wordout(chan,btabsize);
wordout(chan,pagememsize);
wordout(chan,fmemsize);
wordout(chan,locs);
arryout(chan,mem[secondmem],memsize+1-secondmem);
arryout(chan,hash[locs],hashsize+1-locs);
arryout(chan,hhead[0],hprime);
arryout(chan,eqtb[0],eqtbsize);
arryout(chan,exceptable[0],excepsize);
arryout(chan,excephyph[1],excepsize-1);
arryout(chan,suffix[0],sufsize);
arryout(chan,prefix[0],prefsize);
arryout(chan,btable[2],btabsize);
arryout(chan,pagemem[0],pagememsize);
arryout(chan,delimtable[0],128);
arryout(chan,fmem[0],fmemsize);
arryout(chan,fcksum[0],nfonts);
arryout(chan,fsize[0],nfonts);
arryout(chan,dsize[0],nfonts);
arryout(chan,fpfi[0,1],nfonts*5);
arryout(chan,fpfb[0],nfonts);
arryout(chan,wdbase[0],nfonts);
arryout(chan,htbase[0],nfonts);
arryout(chan,dpbase[0],nfonts);
arryout(chan,icbase[0],nfonts);
arryout(chan,lgbase[0],nfonts);
arryout(chan,krbase[0],nfonts);
arryout(chan,extbase[0],nfonts);
arryout(chan,parbase[0],nfonts);
arryout(chan,fontinfo[0],nfonts*128);
wordout(chan,fmemptr);
wordout(chan,hashpar);
wordout(chan,hashsend);
release(chan);

begin integer f, nfnts;
	nfnts←0;
	print(nextline, "Fonts defined:");
	for f←0 thru nfonts-1 do if fontname[f]≠null then
		begin print(nextline,f,":",fontname[f]); nfnts←nfnts+1;
		end;
	if nfnts=0 then print(" None.")
	else print(nextline,nfnts," fonts in all.");
	print(nextline);
end;

print(nextline,"TEX tables written on ",tblname);
end_of_texpre:
end